home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / docs / winer / chap11-9.bas < prev    next >
Encoding:
BASIC Source File  |  1992-05-13  |  3.0 KB  |  83 lines
  1. '*********** CHAP11-9.BAS - reads file names using BASIC PDS REDIM PRESERVE
  2.  
  3. 'Copyright (c) 1992 Ethan Winer
  4.  
  5. DEFINT A-Z
  6. DECLARE SUB LoadNames (FileSpec$, Array$(), Attribute%)
  7.  
  8. '$INCLUDE: 'REGTYPE.BI'
  9.  
  10. TYPE DTA                        'used by find first/next
  11.   Reserved  AS STRING * 21      'reserved for use by DOS
  12.   Attribute AS STRING * 1       'the file's attribute
  13.   FileTime  AS STRING * 2       'the file's time
  14.   FileDate  AS STRING * 2       'the file's date
  15.   FileSize  AS LONG             'the file's size
  16.   FileName  AS STRING * 13      'the file's name
  17. END TYPE
  18.  
  19. DIM SHARED DTAData AS DTA       'shared so LoadNames can
  20. DIM SHARED Registers AS RegType '  access them too
  21.  
  22. REDIM Names$(1 TO 1)             'create a dynamic arrray
  23. Attribute = 19                   'this matches directories only
  24. Attribute = 39                   'this matches all files
  25. Spec$ = "*.*"                    'so does this
  26. CALL LoadNames(Spec$, Names$(), Attribute)
  27.  
  28. IF Names$(1) = "" THEN           'check for no files
  29.   PRINT "No matching files"
  30. ELSE
  31.   FOR X = 1 TO UBOUND(Names$)    'print the names
  32.     PRINT Path$; Names$(X)
  33.   NEXT
  34. END IF
  35.  
  36. SUB LoadNames (FileSpec$, Array$(), Attribute) STATIC
  37.  
  38.   Spec$ = FileSpec$ + CHR$(0)    'make an ASCIIZ string
  39.   Count = 0                      'clear the counter
  40.  
  41.   Registers.DX = VARPTR(DTAData) 'set new DTA address
  42.   Registers.DS = -1              'the DTA is in DGROUP
  43.   Registers.AX = &H1A00          'specify service 1Ah
  44.   CALL DOSInt(Registers)         'DOS set DTA service
  45.  
  46.   IF Attribute AND 16 THEN       'find directory names?
  47.     DirFlag = -1                 'yes
  48.   ELSE
  49.     DirFlag = 0                  'no
  50.   END IF
  51.   
  52.   Registers.DX = SADD(Spec$)     'the file spec address
  53.   Registers.DS = SSEG(Spec$)     'this is for BASIC PDS
  54.   Registers.CX = Attribute       'assign the attribute
  55.   Registers.AX = &H4E00          'find first matching name
  56.  
  57.   DO
  58.     CALL DOSInt(Registers)                        'see if there's a match
  59.     IF Registers.Flags AND 1 THEN EXIT DO         'no more
  60.  
  61.     Valid = 0                                     'invalid until qualified
  62.     IF DirFlag THEN                               'do they want directories?
  63.       IF ASC(DTAData.Attribute) AND 16 THEN       'is it a directory?
  64.         IF LEFT$(DTAData.FileName, 1) <> "." THEN 'filter "." and ".."
  65.           Valid = -1                              'this name is valid
  66.         END IF
  67.       END IF
  68.     ELSE
  69.       Valid = -1                                  'they want regular files
  70.     END IF
  71.  
  72.     IF Valid THEN                                 'process the file if it
  73.       Count = Count + 1                           '  passed all the tests
  74.       REDIM PRESERVE Array$(1 TO Count)           'make room in the array
  75.       Zero = INSTR(DTAData.FileName, CHR$(0))           'find the zero byte
  76.       Array$(Count) = LEFT$(DTAData.FileName, Zero - 1) 'assign the name
  77.     END IF
  78.     
  79.     Registers.AX = &H4F00        'find next matching name service
  80.   LOOP
  81.  
  82. END SUB
  83.